#!/usr/bin/perl

use strict;
use warnings;

binmode STDOUT, ':utf8';

#my $debug = 1;
my $debug = 0;
my $alwayslowercase = 1;

my $TLDurl = 'http://data.iana.org/TLD/tlds-alpha-by-domain.txt';
my $TLDdbFile = 'newTLDs.db';
my $twitterauthfile = 'twitterauth.conf';

use LWP::Simple;
use Net::IDN::Encode;
use Net::Twitter;
use Config::Simple;

my %oldTLDs;
my %newTLDs;

my $TLDdb;
if (open($TLDdb, '<', $TLDdbFile)) {
	while (my $TLD = <$TLDdb>) {
		chomp $TLD;
		$TLD = lc $TLD if $alwayslowercase;
		$oldTLDs{$TLD} = 1 unless $TLD =~ /^#/;
	}
	close($TLDdb);
} else {
	print "Could not open TLD database; initializing database\n";
	$debug = 1;
}

my $newTLDfile = get($TLDurl);

foreach my $TLD (split /^/, $newTLDfile) {
	chomp $TLD;
	$TLD = lc $TLD if $alwayslowercase;
	$newTLDs{$TLD} = 1 unless $TLD =~ /^#/;
}

unless ($debug) {
	if (abs((scalar keys %oldTLDs) - (scalar keys %newTLDs)) > 20) {
		die "More than 20 new TLDs; aborting";
	}
}

open($TLDdb, '>', $TLDdbFile)
	or die "Could not open TLD database";

foreach my $TLD (keys %newTLDs) {
	my $status;
	if (! defined($oldTLDs{$TLD})) {
		$status = "New gTLD: $TLD";
		if ($TLD =~ /^XN--/i) {
			$status .= " (" . Net::IDN::Encode::to_unicode(lc $TLD) . ")";
		}
		tweet($status);
	} else {
		delete $oldTLDs{$TLD};
	}
	print $TLDdb "${TLD}\n";
}

foreach my $TLD (keys %oldTLDs) {
	my $status = "Deleted gTLD: ${TLD}";
	if ($TLD =~ /^XN--/i) {
		$status .= " (" . Net::IDN::Encode::to_unicode(lc $TLD) . ")";
	}
	tweet($status);
}

my $nt = undef;
sub tweet {
	my $status = shift;

	if ( ! $debug ) {
		if ( ! defined($nt) ) {
			my %auth;
			Config::Simple->import_from($twitterauthfile, \%auth);
			$nt = Net::Twitter->new(
				traits   => [qw/API::RESTv1_1/],
				ssl => 1,
				consumer_key        => $auth{'consumer_key'},
				consumer_secret     => $auth{'consumer_secret'},
				access_token        => $auth{'access_token'},
				access_token_secret => $auth{'access_token_secret'}
			);
		}
		my $res;
		eval { $res = $nt->update({ status => $status }) };
		if ( $@ ) {
			warn "Update \"$status\" failed: $@\n";
		}
	} else {
		print $status . "\n";
	}
}
